home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0027_DOS Search Engine.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-15  |  5KB  |  156 lines
  1. UNIT Engine;
  2.  
  3. {$V-}
  4.  
  5. (**************************************************************************)
  6. (* SEARCH ENGINE                                                          *)
  7. (*        Input Parameters:                                               *)
  8. (*              Mask  : The file specification to search for              *)
  9. (*                      May contain wildcards                             *)
  10. (*              Attr  : File attribute to search for                      *)
  11. (*              Proc  : Procedure to process each found file              *)
  12. (*                                                                        *)
  13. (*        Output Parameters:                                              *)
  14. (*              ErrorCode  : Contains the final error code.               *)
  15. (**************************************************************************)
  16.  
  17. (************************)
  18. (**)   INTERFACE      (**)
  19. (************************)
  20.  
  21. USES DOS;
  22.  
  23. TYPE
  24.     ProcType     = PROCEDURE (VAR S : SearchRec; P : PathStr);
  25.     FullNameStr  = STRING[12];
  26.  
  27.     PROCEDURE SearchEngine(Mask : PathStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);
  28.  
  29.     FUNCTION GoodDirectory(S : SearchRec) : Boolean;
  30.     PROCEDURE ShrinkPath(VAR path   : PathStr);
  31.     PROCEDURE ErrorMessage(ErrCode  : Byte);
  32.     PROCEDURE SearchEngineAll(path  : PathStr; Mask : FullNameStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);
  33.  
  34.     (************************)
  35.     (**) IMPLEMENTATION   (**)
  36.     (************************)
  37.  
  38. VAR
  39.     EngineMask : FullNameStr;
  40.     EngineAttr : Byte;
  41.     EngineProc : ProcType;
  42.     EngineCode : Byte;
  43.  
  44.     PROCEDURE SearchEngine(Mask : PathStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);
  45.  
  46.     VAR
  47.        S : SearchRec;
  48.        P : PathStr;
  49.        Ext : ExtStr;
  50.  
  51.     BEGIN
  52.        FSplit(Mask, P, Mask, Ext);
  53.        Mask := Mask + Ext;
  54.        FindFirst(P + Mask, Attr, S);
  55.        IF DosError <> 0 THEN
  56.           BEGIN
  57.                ErrorCode := DosError;
  58.                Exit;
  59.           END;
  60.  
  61.     WHILE DosError = 0 DO
  62.           BEGIN
  63.                Proc(S, P);
  64.                FindNext(S);
  65.           END;
  66.     IF DosError = 18 THEN ErrorCode := 0
  67.     ELSE ErrorCode := DosError;
  68. END;
  69.  
  70. FUNCTION GoodDirectory(S : SearchRec) : Boolean;
  71. BEGIN
  72.     GoodDirectory := (S.name <> '.') AND (S.name <> '..') AND (S.Attr AND Directory = Directory);
  73. END;
  74.  
  75. PROCEDURE ShrinkPath(VAR path : PathStr);
  76. VAR P : Byte;
  77.     Dummy : NameStr;
  78. BEGIN
  79.     FSplit(path, path, Dummy, Dummy);
  80.     Dec(path[0]);
  81. END;
  82.  
  83. {$F+} PROCEDURE SearchOneDir(VAR S : SearchRec; P : PathStr); {$F-}
  84.       {Recursive procedure to search one directory}
  85. BEGIN
  86.     IF GoodDirectory(S) THEN
  87.        BEGIN
  88.             P := P + S.name;
  89.             SearchEngine(P + '\' + EngineMask, EngineAttr, EngineProc, EngineCode);
  90.             SearchEngine(P + '\*.*',Directory OR Archive, SearchOneDir, EngineCode);
  91.        END;
  92. END;
  93.  
  94. PROCEDURE SearchEngineAll(path : PathStr; Mask : FullNameStr; Attr : Byte; Proc : ProcType; VAR ErrorCode : Byte);
  95.  
  96. BEGIN
  97.     (* Set up Unit global variables for use in recursive directory search procedure *)
  98.     EngineMask := Mask;
  99.     EngineProc := Proc;
  100.     EngineAttr := Attr;
  101.     SearchEngine(path + Mask, Attr, Proc, ErrorCode);
  102.     SearchEngine(path + '*.*', Directory OR Attr, SearchOneDir, ErrorCode);
  103.     ErrorCode := EngineCode;
  104. END;
  105.  
  106. PROCEDURE ErrorMessage(ErrCode : Byte);
  107. BEGIN
  108.     CASE ErrCode OF
  109.          0 : ;                              {OK -- no error}
  110.          2 : WriteLn('File not found');
  111.          3 : WriteLn('Path not found');
  112.          5 : WriteLn('Access denied');
  113.          6 : WriteLn('Invalid handle');
  114.          8 : WriteLn('Not enough memory');
  115.          10 : WriteLn('Invalid environment');
  116.          11 : WriteLn('Invalid format');
  117.          18 : ;                    {OK -- merely no more files}
  118.     ELSE WriteLN('ERROR #', ErrCode);
  119.     END;
  120. END;
  121.  
  122.  
  123. END.
  124.  
  125.  
  126. { ===============================   DEMO     ==============================}
  127.  
  128. {$R-,S+,I+,D+,F-,V-,B-,N-,L+ }
  129. {$M 2048,0,0 }
  130. PROGRAM DirSum;
  131.         (*******************************************************)
  132.         (* Uses SearchEngine to write the names of all files   *)
  133.         (* in the current directory and display the total disk *)
  134.         (* space that they occupy.                             *)
  135.         (*******************************************************)
  136. USES DOS,ENGINE;
  137.  
  138. VAR
  139.    Template  : PathStr;
  140.    ErrorCode : Byte;
  141.    Total     : LongInt;
  142.  
  143. {$F+} PROCEDURE WriteIt(VAR S : SearchRec; P : PathStr);  {$F-}
  144. BEGIN   WriteLn(S.name); Total := Total + S.Size END;
  145.  
  146. BEGIN
  147.      Total := 0;
  148.      GetDir(0, Template);
  149.      IF Length(Template) = 3 THEN Dec(Template[0]);
  150.      {^Avoid ending up with "C:\\*.*"!}
  151.      Template := Template + '\*.*';
  152.      SearchEngine(Template, AnyFile, WriteIt, ErrorCode);
  153.      IF ErrorCode <> 0 THEN ErrorMessage(ErrorCode) ELSE
  154.         WriteLn('Total size of displayed files: ', Total : 8);
  155. END.
  156.